home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / Perl_WWW_Utilities / perlMIF_beta2 / mif / mif_tab.pl < prev    next >
Encoding:
Perl Script  |  1994-05-18  |  5.8 KB  |  178 lines
  1. ##---------------------------------------------------------------------------##
  2. ##  File:
  3. ##      mif_tab.pl
  4. ##  Author:
  5. ##      Earl Hood       ehood@convex.com
  6. ##  Description:
  7. ##    This file is defines the "mif_tab" perl package.  It defines
  8. ##    routines to handle TabStop via MIFread_mif() defined in
  9. ##    the "mif" package.
  10. ##---------------------------------------------------------------------------##
  11. ##  Copyright (C) 1994  Earl Hood, ehood@convex.com
  12. ##
  13. ##  This program is free software; you can redistribute it and/or modify
  14. ##  it under the terms of the GNU General Public License as published by
  15. ##  the Free Software Foundation; either version 2 of the License, or
  16. ##  (at your option) any later version.
  17. ## 
  18. ##  This program is distributed in the hope that it will be useful,
  19. ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ##  GNU General Public License for more details.
  22. ##  
  23. ##  You should have received a copy of the GNU General Public License
  24. ##  along with this program; if not, write to the Free Software
  25. ##  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26. ##---------------------------------------------------------------------------##
  27.  
  28. require 'mif/mif.pl' || die "Unable to require mif.pl\n";
  29.  
  30. package mif_tab;
  31.  
  32. ##-----------------------------------------##
  33. ## Add TabStop routines to %MIFToken array ##
  34. ##-----------------------------------------##
  35. $mif'MIFToken{'TabStop'} = "mif_tab'TabStop";
  36. @mif'MIFToken{
  37.     'TSX',
  38.     'TSType',
  39.     'TSLeaderStr',
  40.     'TSDecimalChar'
  41. } = (
  42.     "mif_tab'TSX",
  43.     "mif_tab'TSType",
  44.     "mif_tab'TSLeaderStr",
  45.     "mif_tab'TSDecimalChar"
  46. );
  47.  
  48. ##-------------------##
  49. ## mif_tab variables ##
  50. ##-------------------##
  51. $tab_close_func = "";    # Function to call during TabStop closure.
  52.  
  53. ##------------------------------------------##
  54. ## Variables for current TabStop definition ##
  55. ##------------------------------------------##
  56. $ts_X            = "";
  57. $ts_Type        = "";
  58. $ts_LeaderStr        = "";
  59. $ts_DecimalChar        = "";
  60.  
  61. ##------------------------##
  62. ## Import 'mif' variables ##
  63. ##------------------------##
  64. $MStore        = $mif'MStore;
  65. $MOpen        = $mif'MOpen;
  66. $MClose        = $mif'MClose;
  67. $MLine        = $mif'MLine;
  68. $mso        = $mif'mso;
  69. $msc        = $mif'msc;
  70. $stb        = $mif'stb;
  71. $ste        = $mif'ste;
  72. $como        = $mif'como;
  73.  
  74.                 ##---------------##
  75.                 ## Main Routines ##
  76.                 ##---------------##
  77. ##---------------------------------------------------------------------------
  78. ##    MIFget_tab_func() returns the function that is called when the
  79. ##    TabStop statement closes.
  80. ##
  81. ##    Usage:
  82. ##        $func = &'MIFget_tab_func();
  83. ##
  84. sub main'MIFget_tab_func {
  85.     $tab_close_func;
  86. }
  87. ##---------------------------------------------------------------------------
  88. ##    MIFset_tab_func() sets the function that is called when the
  89. ##    TabStop statement closes.
  90. ##
  91. ##    Usage:
  92. ##        &'MIFset_tab_func($func);
  93. ##
  94. sub main'MIFset_tab_func {
  95.     $tab_close_func = $_[0];
  96. }
  97. ##---------------------------------------------------------------------------
  98. ##    MIFwrite_tab() outputs the TabStop in MIF.
  99. ##
  100. ##    Usage:
  101. ##        &'MIFwrite_tab(FILEHANDLE, $indent,
  102. ##               $X, $Type, $LeaderStr, $DecimalChar);
  103. ##
  104. sub main'MIFwrite_tab {
  105.     local($handle, $l, $X, $Type, $LeaderStr, $DecimalChar) = @_;
  106.     local($i0, $i1, $i2) = (' ' x $l, ' ' x (1+$l), ' ' x (2+$l));
  107.  
  108.     print $handle $i0, $mso, "TabStop\n";
  109.     print $handle $i1, $mso, 'TSX ', $X, $msc, "\n";
  110.     print $handle $i1, $mso, 'TSType ', $Type, $msc, "\n";
  111.     print $handle $i1, $mso, 'TSLeaderStr ', $stb, $LeaderStr, $ste, $msc, "\n";
  112.     print $handle $i1, $mso, 'TSDecimalChar ', $stb, $DecimalChar, $ste,
  113.                $msc, "\n" if $DecimalChar ne "";
  114.     print $handle $i0, $msc, " $como end of TabStop\n";
  115. }
  116. ##---------------------------------------------------------------------------##
  117. ##    MIFget_last_tab_data() is a convienence routine that returns the
  118. ##    data associated with the last TabStop statement.  This routine
  119. ##    is mainly used by other mif_* libraries that need to process
  120. ##    TabStop statements (eg. mif_pgfc).
  121. ##
  122. ##    Usage:
  123. ##        ($x, $type, $leader, $decimalch) = &'MIFget_last_tab_data();
  124. ##
  125. sub main'MIFget_last_tab_data {
  126.     ($ts_X,
  127.      $ts_Type,
  128.      $ts_LeaderStr,
  129.      $ts_DecimalChar);
  130. }
  131. ##---------------------------------------------------------------------------##
  132.                 ##--------------##
  133.                 ## Mif Routines ##
  134.                 ##--------------##
  135. ##---------------------------------------------------------------------------##
  136. ##    The routines definded below are all registered in the %MIFToken         ##
  137. ##    array for use in the MIFread_mif() routine.  There purpose is to     ##
  138. ##    store the information contained in TabStop statement.             ##
  139. ##---------------------------------------------------------------------------##
  140.  
  141. ##---------------------------------------------------------------------------
  142. sub TabStop {
  143.     local($token, $mode, *data) = @_;
  144.  
  145.     if ($mode == $MOpen) {
  146.     $ts_X            = "";
  147.     $ts_Type        = "";
  148.     $ts_LeaderStr        = "";
  149.     $ts_DecimalChar        = "";
  150.     } elsif ($mode == $MClose) {
  151.     &$tab_close_func() if $tab_close_func;
  152.     } else {
  153.     warn "Unexpected mode, $mode, passed to TabStop routine\n";
  154.     }
  155. }
  156. ##---------------------------------------------------------------------------
  157. sub TSX {
  158.     local($token, $mode, *data) = @_;
  159.     ($ts_X) = $data =~ /^\s*(.*)$/o;
  160. }
  161. ##---------------------------------------------------------------------------
  162. sub TSType {
  163.     local($token, $mode, *data) = @_;
  164.     ($ts_Type) = $data =~ /^\s*(.*)$/o;
  165. }
  166. ##---------------------------------------------------------------------------
  167. sub TSLeaderStr {
  168.     local($token, $mode, *data) = @_;
  169.     ($ts_LeaderStr) = $data =~ /^\s*$stb([^$ste]*)$ste.*$/o;
  170. }
  171. ##---------------------------------------------------------------------------
  172. sub TSDecimalChar {
  173.     local($token, $mode, *data) = @_;
  174.     ($ts_DecimalChar) = $data =~ /^\s*(.*)$/o;
  175. }
  176. ##---------------------------------------------------------------------------
  177. 1;
  178.